home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 71.zip / BS1 part 71 / AmosPro2.0_d5.adf / Extensions / |compact.s < prev    next >
Text File  |  1992-09-28  |  16KB  |  718 lines
  1. ;---------------------------------------------------------------------
  2. ;    **   **   **  ***   ***   ****     **    ***  **  ****
  3. ;   ****  *** *** ** ** **     ** **   ****  **    ** **  **
  4. ;  **  ** ** * ** ** **  ***   *****  **  **  ***  ** **
  5. ;  ****** **   ** ** **    **  **  ** ******    ** ** **
  6. ;  **  ** **   ** ** ** *  **  **  ** **  ** *  ** ** **  **
  7. ;  **  ** **   **  ***   ***   *****  **  **  ***  **  ****
  8. ;---------------------------------------------------------------------
  9. ; AMOSPro Picture compactor extension source code,
  10. ; By François Lionet
  11. ; AMOS, AMOSPro and AMOS Compiler (c) Europress Software 1990-1992
  12. ; To be used with AMOS1.3 and over
  13. ;--------------------------------------------------------------------- 
  14. ; This file is public domain
  15. ;---------------------------------------------------------------------
  16. ; Please refer to the _Music.s file for more informations
  17. ;---------------------------------------------------------------------
  18. *
  19. Version        MACRO
  20.         dc.b    "1.0"
  21.         ENDM
  22. *
  23. *
  24. ExtNb        equ    2-1
  25. *
  26.         Include "|AMOS_Includes.s"
  27. *
  28. Start        dc.l    C_Tk-C_Off
  29.         dc.l    C_Lib-C_Tk
  30.         dc.l    C_Title-C_Lib
  31.         dc.l    C_End-C_Title
  32.         dc.w    0
  33.  
  34. ***********************************************************
  35. *         OFFSETS TO FUNCTIONS
  36. C_Off       dc.w (L1-L0)/2,(L2-L1)/2,(L3-L2)/2,(L4-L3)/2
  37.             dc.w (L5-L4)/2,(L6-L5)/2,(L7-L6)/2,(L8-L7)/2
  38.             dc.w (L9-L8)/2,(L10-L9)/2,(L11-L10)/2,(L12-L11)/2
  39.                dc.w (L13-L12)/2,(L14-L13)/2,(L15-L14)/2,(L16-L15)/2
  40.             dc.w (L17-L16)/2,(L18-L17)/2,(L19-L18)/2,(L20-L19)/2
  41.         dc.w (L21-L20)/2,(L22-L21)/2,(L23-L22)/2
  42.  
  43. ***********************************************************
  44. *         COMPACTOR TOKENS
  45. C_Tk        dc.w     1,0
  46.         dc.b     $80,-1
  47.         dc.w     L_Pack2,-1
  48.         dc.b     "!pac","k"+$80,"I0t0",-2
  49.         dc.w    L_Pack6,-1
  50.         dc.b    $80,"I0t0,0,0,0,0",-1
  51.         dc.w     L_SPack2,-1
  52.         dc.b     "!spac","k"+$80,"I0t0",-2
  53.         dc.w    L_SPack6,-1
  54.         dc.b    $80,"I0t0,0,0,0,0",-1
  55.         dc.w    L_UPack1,-1
  56.         dc.b    "!unpac","k"+$80,"I0",-2
  57.         dc.w     L_UPack2,-1
  58.         dc.b    $80,"I0t0",-2
  59.         dc.w     L_UPack3,-1
  60.         dc.b    $80,"I0,0,0",-1
  61.         dc.w     0
  62.  
  63. ******************************************************************
  64. *        Start of library
  65. C_Lib
  66.  
  67. ******************************************************************
  68. *        COLD START
  69. L0    moveq    #ExtNb,d0
  70.     rts
  71.  
  72. ******************************************************************
  73. *
  74. L1
  75.  
  76. ******************************************************************
  77. *    
  78. L2
  79.  
  80. ******************************************************************
  81. *        PACK Screen,Bank#
  82. L_Pack2        equ    3
  83. L3    clr.l    -(a3)
  84.     clr.l    -(a3)
  85.     move.l    #10000,-(a3)
  86.     move.l    (a3),-(a3)
  87.     RBra    L_Pack6
  88.  
  89. ******************************************************************
  90. *        PACK Screen,Bank#
  91. L_Pack6        equ    4
  92. L4    Rbsr    L_PacPar
  93.     Rbsr    L_GetSize
  94.     Rbsr    L_ResBank
  95.     Rbsr    L_Pack
  96.     rts
  97.  
  98. *******************************************************************
  99. *        SPACK Screen,Bank#
  100. L_SPack2    equ    5
  101. L5    clr.l    -(a3)
  102.     clr.l    -(a3)
  103.     move.l    #10000,-(a3)
  104.     move.l    (a3),-(a3)
  105.     Rbra    L_SPack6
  106.  
  107. *******************************************************************
  108. *        SPACK Screen,Bank#,X1,Y1 TO X2,Y2
  109. L_SPack6    equ    6
  110. L6    Rbsr    L_PacPar
  111.     Rbsr    L_GetSize
  112.     add.l    #PsLong,d0
  113.     Rbsr    L_ResBank
  114. * Screen definition header
  115.     move.l    #SCCode,(a1)
  116.     move.w    EcTx(a0),PsTx(a1)
  117.     move.w    EcTy(a0),PsTy(a1)
  118.     move.w    EcNbCol(a0),PsNbCol(a1)
  119.     move.w    EcNPlan(a0),PsNPlan(a1)
  120.     move.w    EcCon0(a0),PsCon0(a1)
  121.     move.w    EcAWX(a0),PsAWX(a1)
  122.     move.w    EcAWY(a0),PsAWY(a1)
  123.     move.w    EcAWTX(a0),PsAWTX(a1)
  124.     move.w    EcAWTY(a0),PsAWTY(a1)
  125.     move.w    EcAVX(a0),PsAVX(a1)
  126.     move.w    EcAVY(a0),PsAVY(a1)
  127.     movem.l    a0/a1,-(sp)
  128.     moveq    #31,d0
  129.     lea    EcPal(a0),a0
  130.     lea    PsPal(a1),a1
  131. SPac1    move.w    (a0)+,(a1)+
  132.     dbra    d0,SPac1
  133.     movem.l    (sp)+,a0/a1
  134.     lea    PsLong(a1),a1
  135. * Finish packing!
  136.     Rbsr    L_Pack
  137.     rts
  138.  
  139. *************************************************************************
  140. *        UNPACK Bank#         -> To current screen
  141. L_UPack1    equ    7
  142. L7    move.l    ScOnAd(a5),d0
  143.     Rbeq    L_JFonCall
  144.     move.l    d0,a1
  145.     moveq    #-1,d1
  146.     moveq    #-1,d2
  147.     Rbra    L_UPack
  148.  
  149. *************************************************************************
  150. *        UNPACK Bank#,X,Y    -> To current screen
  151. L_UPack3    equ    8
  152. L8    move.l    ScOnAd(a5),d0
  153.     Rbeq    L_JFonCall
  154.     move.l    d0,a1
  155.     move.l    (a3)+,d2
  156.     move.l    (a3)+,d1
  157.     lsr.l    #3,d1
  158.     Rbra    L_UPack
  159.  
  160. L_UPack        equ    9
  161. L9    movem.l    d1/a1,-(sp)
  162.      move.l    (a3)+,d0
  163.     RJsr    L_Bnk.OrAdr
  164.     movem.l    (sp)+,d1/a1
  165. * Autoback 
  166.     tst.w    EcAuto(a1)        * Is screen autobacked?
  167.     Rbeq    L_UnPack        * NOPE! Do simple unpack
  168.     movem.l    d0-d7/a0-a2,-(sp)    * YEP! First step
  169.     EcCall    AutoBack1
  170.     movem.l    (sp),d0-d7/a0-a2
  171.     btst    #BitDble,EcFlags(a1)    * DOUBLE BUFFER?
  172.     beq.s    ABPac1
  173.     Rbsr    L_UnPack
  174.     EcCall    AutoBack2        * Second step
  175.     movem.l    (sp),d0-d7/a0-a2
  176.     Rbsr    L_UnPack
  177.     EcCall    AutoBack3        * Third step
  178.     bra.s    ABPac2
  179. ABPac1    Rbsr    L_UnPack        * SINGLE BUFFER autobacked
  180.     EcCall    AutoBack4
  181. ABPac2    movem.l    (sp)+,d0-d7/a0-a2
  182.     rts
  183.  
  184. *************************************************************************
  185. *        UNPACK Bank# TO screen    -> Creates/Erases screen!
  186. L_UPack2    equ    10
  187. L10    move.l    (a3)+,d1
  188.     cmp.l    #8,d1
  189.     Rbcc    L_JFoncall
  190. * Creates new screen
  191.     move.l    d1,-(sp)
  192.     move.l    (a3)+,d0
  193.     RJsr    L_Bnk.OrAdr
  194.     move.l    (sp)+,d1
  195.     cmp.l    #SCCode,PsCode(a0)
  196.     Rbne    L_NoScr
  197.     moveq    #0,d2
  198.     moveq    #0,d3
  199.     moveq    #0,d4
  200.     moveq    #0,d5
  201.     move.w    PsTx(a0),d2
  202.     move.w    PsTy(a0),d3
  203.     move.w    PsNPlan(a0),d4
  204.     move.w    PsCon0(a0),d5
  205.     move.w    PsNbCol(a0),d6
  206.     lea    PsPal(a0),a1
  207.     move.l    a0,-(sp)
  208.     EcCall    Cree
  209.     Rbne    L_JOOfMem
  210.     move.l    a0,a1
  211.     move.l    (sp)+,a0
  212.     move.l    a1,ScOnAd(a5)
  213.     move.w    EcNumber(a1),ScOn(a5)
  214.     addq.w    #1,ScOn(a5)
  215. * Enleve le curseur
  216.     movem.l    a0-a6/d0-d7,-(sp)
  217.     lea    CuCuOff(pc),a1
  218.     WiCall    Print
  219.     movem.l    (sp)+,a0-a6/d0-d7
  220. * Change View/Offset
  221.     move.w    PsAWX(a0),EcAWX(a1)
  222.     move.w    PsAWY(a0),EcAWY(a1)
  223.     move.w    PsAWTx(a0),EcAWTx(a1)
  224.     move.w    PsAWTy(a0),EcAWTy(a1)
  225.     move.w    PsAVX(a0),EcAVX(a1)
  226.     move.w    PsAVY(a0),EcAVY(a1)
  227.     move.b    #%110,EcAW(a1)
  228.     move.b    #%110,EcAWT(a1)
  229.     move.b    #%110,EcAV(a1)
  230. * Unpack!
  231.     lea    PsLong(a0),a0
  232.     moveq    #0,d1
  233.     moveq    #0,d2
  234.     Rbra    L_UnPack
  235. CuCuOff    dc.b    27,"C0",0
  236.     even
  237.  
  238. ***********************************************************
  239. *        Reserves memory bank, A1= number
  240. L_ResBank    equ    11
  241. L11    movem.l    a0/d1/d2,-(sp)
  242.     move.l    d0,d2
  243.     moveq    #(1<<Bnk_BitData),d1
  244.     move.l    a1,d0
  245.     lea    BkPac(pc),a0
  246.     Rjsr    L_Bnk.Reserve
  247.     Rbeq    L_JOOfMem
  248.     move.l    a0,a1 
  249.     movem.l    (sp)+,a0/d1/d2
  250.     rts
  251. ******* Definition banque de samples
  252. BkPac:    dc.b "Pac.Pic."
  253.     even
  254.  
  255. ***********************************************************
  256. *        Unpile parameters
  257. L_PacPar    equ    12
  258. L12    move.l    (a3)+,d5
  259.     move.l    (a3)+,d4
  260.     move.l    (a3)+,d3
  261.     move.l    (a3)+,d2
  262.     lsr.w    #3,d4
  263.     lsr.w    #3,d2
  264. * Screen
  265.     move.l    4(a3),d1
  266.     RJsr    L_GetEc
  267.     move.l    d0,a2
  268.     cmp.w    EcTLigne(a0),d4
  269.     bls.s    PacP1
  270.     move.w    EcTLigne(a0),d4
  271. PacP1    cmp.w    EcTy(a0),d5
  272.     bls.s    PacP2
  273.     move.w    EcTy(a0),d5
  274. PacP2    sub.w    d2,d4
  275.     Rble    L_JFoncall
  276.     sub.w    d3,d5
  277.     Rble    L_JFoncall
  278. ; Number of memory bank
  279.     move.l    (a3)+,a1
  280.     cmp.l    #$10000,a1
  281.     Rbcc    L_JFoncall
  282.     addq.l    #4,a3
  283.     rts
  284.  
  285. ***************************************************************************
  286. * 
  287. *       BITMAP COMPACTOR
  288. *                       A0: Origin screen datas
  289. *                       A1: Destination zone
  290. *            A2: Origin screen bitmap
  291. *                       D2: DX in BYTES
  292. *                       D3: DY in LINES
  293. *                       D4: TX in BYTES
  294. *                       D5: TY in LINES
  295. *
  296. ***************************************************************************
  297. *     ESTIMATE THE SIZE OF A PICTURE
  298.  
  299. ******* Makes differents tries
  300. *    And finds the best square size in D1
  301. L_GetSize    equ    13
  302. L13    movem.l    a1-a3,-(sp)
  303.     lea    TSize(pc),a3
  304.     move.l    Buffer(a5),a1
  305.     moveq    #0,d7
  306.     move.w    d5,d7
  307.     clr.w    -(sp)
  308.     move.l    #$10000000,-(sp)
  309. GSize1    move.l    d7,d5
  310.     move.w    (a3)+,d1
  311.     beq.s    GSize2
  312.     divu    d1,d5
  313.     swap    d5
  314.     tst.w    d5
  315.     bne.s    GSize1
  316.     swap    d5
  317.     bsr    PacSize
  318.     cmp.l    (sp),d0
  319.     bcc.s    GSize1
  320.     move.l    d0,(sp)
  321.     move.w    d1,4(sp)
  322.     bra.s    GSize1
  323. GSize2    move.l    (sp)+,d0
  324.     move.w    (sp)+,d1
  325.     move.l    d7,d5
  326.     divu    d1,d5
  327.     movem.l    (sp)+,a1-a3
  328.     rts
  329.  
  330. ******* Simulate a packing
  331. PacSize    movem.l    d1-d7/a0-a6,-(sp)
  332. * Fake data zone
  333.         move.w     d2,Pkdx(a1)
  334.         move.w     d3,Pkdy(a1)  
  335.         move.w     d4,Pktx(a1)  
  336.         move.w     d5,Pkty(a1)   
  337.         move.w     d1,Pktcar(a1)  
  338. * Reserve intermediate table space
  339.     move.w    d1,d0
  340.     mulu    d4,d0
  341.     mulu    d5,d0
  342.     mulu    EcNPlan(a0),d0
  343.     lsr.l    #3,d0
  344.     addq.l    #2,d0
  345.     move.l    d0,-(sp)
  346.     move.l    a0,-(sp)
  347.     Rjsr    L_RamFast
  348.     Rbeq    L_JOofMem
  349.     move.l    (sp)+,a0
  350.     move.l    d0,a6
  351.     move.l    d0,-(sp)
  352. * Prepare registers
  353.         move.l    a2,a4                ;a4--> picture address
  354.         lea     PkDatas1(a1),a5            ;a5--> main datas
  355.     move.w    EcTLigne(a0),d7
  356.     move.w    d7,d5
  357.     mulu    d1,d5            ;d5--> SY line of square
  358.         move.w     Pkdy(a1),d3
  359.         mulu     d7,d3
  360.         move.w     Pkdx(a1),d0
  361.     ext.l    d0
  362.     add.l    d0,d3
  363.     move.w    EcNPlan(a0),-(sp)
  364. * Main packing
  365.         moveq     #7,d1                  * Bit pointer
  366.     moveq    #0,d0
  367. Iplan:  move.l     (a4)+,a3
  368.     add.l    d3,a3
  369.         move.w     Pkty(a1),d6
  370.     subq.w    #1,d6
  371. Iligne: move.l     a3,a2
  372.     move.w    Pktx(a1),d4
  373.     subq.w    #1,d4
  374. Icarre: move.l     a2,a0
  375.         move.w     Pktcar(a1),d2
  376.     subq.w    #1,d2
  377. Ioct0:     cmp.b     (a0),d0             * Compactage d'un carre
  378.         beq.s     Ioct1
  379.     move.b    (a0),d0
  380.         addq.l     #1,a5
  381.         bset     d1,(a6)
  382. Ioct1:  dbra     d1,Ioct2
  383.         moveq     #7,d1
  384.         addq.l     #1,a6
  385.     clr.b    (a6)
  386. Ioct2:  add.w     d7,a0
  387.         dbra     d2,Ioct0
  388.         addq.l    #1,a2    
  389.         dbra     d4,Icarre    
  390.     add.l    d5,a3    
  391.         dbra     d6,Iligne    
  392.     subq.w    #1,(sp)
  393.     bne.s    IPlan
  394.     addq.l    #2,sp
  395.     addq.l    #1,a5
  396. * Packing of first pointers table
  397.     move.l    a5,a6
  398.     move.l    4(sp),d2
  399.     move.l    d2,d0
  400.     subq.w    #1,d2
  401.     lsr.w    #3,d0
  402.     addq.w    #2,d0
  403.     add.w    d0,a5
  404.     move.l    (sp),a0
  405.     moveq    #0,d0
  406.         moveq     #7,d1
  407. Icomp2  cmp.b     (a0)+,d0
  408.         beq.s     Icomp2a
  409.     move.b    -1(a0),d0
  410.         addq.l     #1,a5
  411. Icomp2a dbra    d2,Icomp2
  412. * Final size (EVEN!)
  413.     move.l    a5,d2
  414.     sub.l    a1,d2
  415.     addq.l    #3,d2
  416.     and.l    #$FFFFFFFE,d2
  417. * Free intermediate memory
  418.     move.l    (sp)+,a1
  419.     move.l    (sp)+,d0
  420.     Rjsr    L_RamFree
  421. * Finished!
  422.     move.l    d2,d0
  423.     movem.l    (sp)+,d1-d7/a0-a6
  424.     rts
  425. ******* Packing methods
  426. TSize    dc.w     1,2,3,4,5,6,7,8,12,16,24,32,48,64,0
  427.  
  428.  
  429. ***********************************************************
  430. *    REAL PACKING!!!
  431. L_Pack        equ    14
  432. L14
  433. * Header of the packed bitmap
  434.     movem.l    d1-d7/a0-a6,-(sp)
  435.  
  436. * Packed bitmap header
  437.         move.l     #BMCode,PkCode(a1)
  438.         move.w     d2,Pkdx(a1)
  439.         move.w     d3,Pkdy(a1)  
  440.         move.w     d4,Pktx(a1)  
  441.         move.w     d5,Pkty(a1)   
  442.         move.w     d1,Pktcar(a1)  
  443.     move.w    EcNPlan(a0),PkNPlan(a1)
  444.  
  445. * Reserve intermediate table space
  446.     move.w    d1,d0
  447.     mulu    d4,d0
  448.     mulu    d5,d0
  449.     mulu    EcNPlan(a0),d0
  450.     lsr.l    #3,d0
  451.     addq.l    #2,d0
  452.     move.l    d0,-(sp)
  453.     move.l    a0,-(sp)
  454.     Rjsr    L_RamFast
  455.     Rbeq    L_JOofMem
  456.     move.l    (sp)+,a0
  457.     move.l    d0,a6
  458.     move.l    d0,-(sp)
  459.  
  460. * Prepare registers
  461.         move.l    a2,a4                ;a4--> picture address
  462.         lea     PkDatas1(a1),a5            ;a5--> main datas
  463.     move.w    EcTLigne(a0),d7
  464.     move.w    d7,d5
  465.     mulu    d1,d5            ;d5--> SY line of square
  466.         move.w     Pkdy(a1),d3
  467.         mulu     d7,d3
  468.         move.w     Pkdx(a1),d0
  469.     ext.l    d0
  470.     add.l    d0,d3
  471.     move.w    EcNPlan(a0),-(sp)
  472.  
  473. * Main packing
  474.         moveq     #7,d1                  * Bit pointer
  475.     moveq    #0,d0
  476.         clr.b     (a5)                  * First byte to zero
  477.         clr.b     (a6)              
  478. plan:   move.l     (a4)+,a3
  479.     add.l    d3,a3
  480.         move.w     Pkty(a1),d6
  481.     subq.w    #1,d6
  482. ligne:  move.l     a3,a2
  483.     move.w    Pktx(a1),d4
  484.     subq.w    #1,d4
  485. carre:  move.l     a2,a0
  486.         move.w     Pktcar(a1),d2
  487.     subq.w    #1,d2
  488. oct0:     cmp.b     (a0),d0             * Compactage d'un carre
  489.         beq.s     oct1
  490.     move.b    (a0),d0
  491.         addq.l     #1,a5
  492.         move.b     d0,(a5)
  493.         bset     d1,(a6)
  494. oct1:   dbra     d1,oct2
  495.         moveq     #7,d1
  496.         addq.l     #1,a6
  497.         clr.b     (a6)
  498. oct2:   add.w     d7,a0
  499.         dbra     d2,oct0
  500.         addq.l    #1,a2            * Carre suivant en X
  501.         dbra     d4,carre    
  502.     add.l    d5,a3            * Ligne suivante
  503.         dbra     d6,ligne    
  504.     subq.w    #1,(sp)            * Plan couleur suivant
  505.     bne.s    Plan
  506.     addq.l    #2,sp
  507.     addq.l    #1,a5
  508.  
  509. ; Packing of first pointers table
  510.     move.l    a5,d0
  511.     sub.l    a1,d0
  512.     move.l    d0,PkPoint2(a1)
  513.     move.l    a5,a6
  514.     move.l    4(sp),d0
  515.     move.l    d0,d2
  516.     subq.w    #1,d2
  517.     lsr.w    #3,d0
  518.     addq.w    #2,d0
  519.     add.w    d0,a5
  520.     move.l    a5,d0
  521.     sub.l    a1,d0
  522.     move.l    d0,PkDatas2(a1)
  523.     move.l    (sp),a0
  524.     moveq    #0,d0
  525.         moveq     #7,d1
  526.         clr.b     (a5)
  527.         clr.b     (a6)
  528. comp2:  cmp.b     (a0)+,d0
  529.         beq.s     comp2a
  530.     move.b    -1(a0),d0
  531.         addq.l     #1,a5
  532.         move.b     d0,(a5)
  533.         bset     d1,(a6)
  534. comp2a: dbra     d1,comp2b
  535.         moveq     #7,d1
  536.         addq.l     #1,a6
  537.         clr.b     (a6)
  538. comp2b: dbra    d2,Comp2
  539.  
  540. * Free intermediate memory
  541.     move.l    (sp)+,a1
  542.     move.l    (sp)+,d0
  543.     RJsr    L_RamFree
  544.     movem.l    (sp)+,d1-d7/a0-a6
  545.     rts
  546.  
  547. ***********************************************************
  548. *        Bitmap unpacker
  549. *        A0-> packed picture
  550. *        A1-> Destination screen
  551. *        D1.L Start in X
  552. *        D2.L Start in Y
  553. UAEc:    equ 0
  554. UDEc:    equ 4
  555. UITy:    equ 8
  556. UTy:    equ 10
  557. UTLine:    equ 12
  558. UNPlan:    equ 14
  559. UPile:    equ 16
  560. L_UnPack    equ    15
  561. L15    movem.l    a0-a6/d1-d7,-(sp)
  562.  
  563. * Jump over SCREEN DEFINITION
  564.     cmp.l    #SCCode,(a0)
  565.     bne.s    dec0
  566.     lea    PsLong(a0),a0
  567. * Is it a packed bitmap?
  568. dec0    cmp.l    #BMCode,(a0)
  569.     Rbne    L_NoPac
  570.  
  571. * Parameter preparation
  572.     lea    -UPile(sp),sp        * Space to work
  573.     lea    EcCurrent(a1),a2
  574.     move.l    a2,UAEc(sp)        * Bitmaps address
  575.         move.w     EcTLigne(a1),d7        * d7--> line size
  576.     move.w    EcNPlan(a1),d0        * How many bitplanes
  577.     cmp.w    PkNPlan(a0),d0
  578.     Rbne    L_JFoncall
  579.     move.w    d0,UNPlan(sp)
  580.     move.w    Pktcar(a0),d6        * d6--> SY square
  581.  
  582.         tst.l     d1            * Screen address in X
  583.         bpl.s     dec1
  584.         move.w     Pkdx(a0),d1
  585. dec1:   tst.l     d2            * In Y
  586.         bpl.s     dec2
  587.         move.w     Pkdy(a0),d2
  588. dec2:   move.w    Pktx(a0),d0
  589.     add.w    d1,d0
  590.     cmp.w    d7,d0
  591.     Rbhi    L_JFoncall
  592.     move.w    Pkty(a0),d0
  593.     mulu    d6,d0
  594.     add.w    d2,d0
  595.     cmp.w    EcTy(a1),d0
  596.     Rbhi    L_JFoncall
  597.  
  598.     mulu    d7,d2            * Screen address
  599.     ext.l    d1    
  600.     add.l    d2,d1
  601.     move.l    d1,UDEc(sp)
  602.     
  603.     move.w    d6,d0            * Size of one line
  604.         mulu     d7,d0
  605.         move     d0,UTLine(sp)
  606.  
  607.         move.w     Pktx(a0),a3        * Size in X
  608.         subq.w    #1,a3
  609.         move.w     Pkty(a0),UITy(sp)    * in Y
  610.         lea     PkDatas1(a0),a4            * a4--> bytes table 1
  611.         move.l     a0,a5
  612.         move.l     a0,a6
  613.         add.l     PkDatas2(a0),a5         * a5--> bytes table 2
  614.         add.l     PkPoint2(a0),a6         * a6--> pointer table
  615.  
  616.         moveq     #7,d0            
  617.         moveq     #7,d1
  618.         move.b     (a5)+,d2
  619.         move.b     (a4)+,d3
  620.         btst     d1,(a6)
  621.         beq.s     prep
  622.         move.b     (a5)+,d2
  623. prep:   subq.w     #1,d1
  624.  
  625. * Unpack!
  626. dplan:  move.l     UAEc(sp),a2
  627.     addq.l    #4,UAEc(sp)
  628.     move.l    (a2),a2
  629.     add.l    UDEc(sp),a2
  630.         move.w     UITy(sp),UTy(sp)    * Y Heigth counter
  631. dligne: move.l     a2,a1
  632.         move.w     a3,d4
  633. dcarre: move.l     a1,a0
  634.         move.w     d6,d5           * Square height
  635. doctet1:subq.w     #1,d5
  636.         bmi.s     doct3
  637.         btst     d0,d2
  638.         beq.s     doct1
  639.         move.b     (a4)+,d3
  640. doct1:  move.b     d3,(a0)
  641.         add.w     d7,a0
  642.         dbra     d0,doctet1
  643.         moveq     #7,d0
  644.         btst     d1,(a6)
  645.         beq.s     doct2
  646.         move.b     (a5)+,d2
  647. doct2:  dbra     d1,doctet1
  648.         moveq     #7,d1
  649.         addq.l     #1,a6
  650.         bra.s     doctet1
  651. doct3:  addq.l    #1,a1               * Other squares?
  652.         dbra     d4,Dcarre
  653.         add.w     UTLine(sp),a2              * Other square line?
  654.         subq.w     #1,UTy(sp)
  655.         bne.s     Dligne
  656.         subq.w     #1,UNPlan(sp)
  657.         bne.s     Dplan
  658.         lea    UPile(sp),sp            * Restore the pile
  659. * Finished!
  660.     movem.l    (sp)+,a0-a6/d1-d7
  661.     rts
  662.  
  663.  
  664. ***********************************************************
  665. *        JUMP TO ERROR MESSAGES
  666. L_JFoncall    equ    16
  667. L16    moveq    #23,d0
  668.     RJmp    L_Error
  669. L_JScnop    equ    17
  670. L17    moveq    #47,d0
  671.     RJmp    L_Error
  672. L_JOOfmem    equ    18
  673. L18    moveq    #24,d0
  674.     RJmp    L_Error
  675.  
  676. ***********************************************************
  677. *        ERROR HANDLING
  678. L_NoPac        equ    19
  679. L19    moveq    #0,d0
  680.     RBra    L_Custom
  681. L_NoScr        equ    20
  682. L20    moveq    #1,d0
  683.     RBra    L_Custom
  684.  
  685. ***********************************************************
  686. *        ERROR MESSAGES
  687.  
  688. ******* First routine
  689. L_Custom    equ    21
  690. L21    lea    ErrMes(pc),a0
  691.     moveq    #0,d1
  692.     moveq    #ExtNb,d2
  693.     moveq    #0,d3
  694.     RJmp    L_ErrorExt
  695. ErrMes    dc.b     "Not a packed bitmap",0
  696.     dc.b     "Not a packed screen",0
  697.     even    
  698. ******* Second routine
  699. L22    moveq    #0,d1
  700.     moveq    #ExtNb,d2
  701.     moveq    #0,d3
  702.     RJmp    L_ErrorExt
  703. L23
  704.  
  705. ***********************************************************
  706. *         Welcome message
  707. C_Title        dc.b     "AMOSPro Picture Compactor V "
  708.         Version
  709.         dc.b    0,"$VER: "
  710.         Version
  711.         dc.b    0
  712.         Even
  713.  
  714. ***********************************************************
  715. C_End    dc.w    0
  716.  
  717.  
  718.